home *** CD-ROM | disk | FTP | other *** search
- unit ParentMainFormUnit;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- Menus, StdCtrls, ExtCtrls;
-
- type
- TForm1 = class(TForm)
- Memo1: TMemo;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- private
- PipeRead: THandle;
- end;
-
- {$ifdef Ver90}
- //This exception class did not exist in Delphi 2
- EWin32Error = class(Exception);
-
- const
- //Constant not defined in Delphi 2
- Duplicate_Same_Access = 2;
- {$endif}
-
- var
- Form1: TForm1;
-
- implementation
-
- uses
- ParentAnonymousPipeUnit;
-
- {$R *.DFM}
-
- {$ifdef Ver90}
- //This function class did not exist in Delphi 2
- function Win32Check(RetVal: Bool): Bool;
- var
- LastError: DWord;
- begin
- Result := RetVal;
- if not RetVal then
- begin
- LastError := GetLastError;
- if LastError <> Error_Success then
- raise EWin32Error.CreateFmt( 'Win32 Error. Code: %d.'#10'%s',
- [LastError, SysErrorMessage(LastError)])
- else
- raise EWin32Error.Create('A Win32 API function failed')
- end;
- end;
- {$endif}
-
- function LaunchChildApp: THandle;
- const
- ChildApp = 'ChildAnonymousPipe.Exe';
- var
- SI: TStartupInfo;
- PI: TProcessInformation;
- begin
- GetStartupInfo(SI);
- if not CreateProcess(nil, ChildApp, nil, nil,
- //Make sure child inherits our inheritable handles
- //as it will need to refer to them to use the pipes
- True,
- 0, nil, nil, SI, PI) then
- raise EWin32Error.Create('Unable to launch ' + ChildApp);
- Result := PI.HProcess
- end;
-
- {This will create an anonymous pipe and get a read and write handle
- back. The intention is for a child app to write to the pipe and for
- this parent app to read from the pipe.
- The security attributes will be specified to ensure that
- child processes can inherit these handles (i.e use their values)
- To communicate the write pipe handle value to the child app
- the STDOUT handle of this process will be replaced with the pipe
- handle. The child process will get a copy of this process's
- standard handles and so will inherit it.
- To ensure there is only one write handle and one read handle
- (for solid error trapping to work) this process must close its write
- handle after launching the child and before reading from the pipe.
- Also, to ensure the child cannot use the read pipe handle, we
- will duplicate the given handle and make it non-inheritable.}
- procedure TForm1.FormCreate(Sender: TObject);
- var
- Security: TSecurityAttributes;
- ThisProcess, PipeReadTmp, PipeWrite: THandle;
- const
- PipeBufferSize = 0; //default size
- begin
- with Security do
- begin
- nLength := SizeOf(Security);
- bInheritHandle := True; //create inheritable handles
- lpSecurityDescriptor := nil;
- end;
- Win32Check(CreatePipe(PipeRead, PipeWrite, @Security, PipeBufferSize));
- //Turn STDOUT into the write pipe handle
- Win32Check(SetStdHandle(Std_Output_Handle, PipeWrite));
- //Ensure pipe read handle is not inheritable
- ThisProcess := GetCurrentProcess();
- Win32Check(DuplicateHandle(ThisProcess, PipeRead, ThisProcess,
- @PipeReadTmp, 0, False, Duplicate_Same_Access));
- CloseHandle(PipeRead);
- PipeRead := PipeReadTmp;
- //This launches the child process and waits for it to
- //settle down before moving on to the next statement
- WaitForInputIdle(LaunchChildApp, Infinite);
- //Ensure only the child has an open write pipe handle
- CloseHandle(PipeWrite);
- //Start reader thread off
- with TTestAnonymousPipe.Create(PipeRead) do
- FreeOnTerminate := True
- end;
-
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- CloseHandle(PipeRead);
- end;
-
- end.
-